home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
appoint.bas
< prev
next >
Wrap
BASIC Source File
|
1985-06-03
|
8KB
|
180 lines
10 DIM G$(6),M(13)
20 FOR I = 1 TO 6:READ G$(I) :NEXT I
30 FOR I = 1 TO 13:READ M(I):NEXT I
40 CLS
50 INPUT "Are you starting a new nagging file (Y/N)";I$:IF I$ = "" THEN END
60 IF ASC(I$) > 90 THEN PRINT "Please type in upper case only.":GOTO 50
70 IF I$="N" THEN INPUT "What is the name of the file you want to use";QU$:WR = 0:GOTO 100
80 INPUT "What name do you want to give it";QU$:IF QU$ = "" THEN 50
90 OPEN "O",1,"A:"+QU$+".NAG":WRITE #1,0,0:CLOSE #1:WR = 1
100 IF QU$ = "" THEN 50
110 OPEN "I",1,"A:"+QU$+".NAG":INPUT #1,N,E:NT = N + 50:ET = E + 10
120 DIM A$(NT),S(NT),F(NT),P(NT),L$(ET),T(ET)
130 FOR I = 1 TO N:INPUT #1,A$(I),S(I),F(I),P(I):NEXT I
140 FOR I = 1 TO E:INPUT #1,L$(I),T(I)
150 NEXT I:CLOSE #1
160 CLS:PRINT "Would you like to":PRINT
170 PRINT " 1. LIST ACTIVITIES FOR A PARTICULAR DAY"
180 PRINT " 2. List all events"
190 PRINT " 3. List activities relating to an event"
200 PRINT " 4. List all activities"
210 PRINT:PRINT " 5. Add a new event and activities relating to it"
220 PRINT " 6. Add activities relating to an event"
230 PRINT " 7. Delete an event and all activites relating to it"
240 PRINT " 8. Delete or change an activity":PRINT
250 PRINT " 9. Quit the program and save any changes"
260 PRINT:INPUT CH:CLS
270 ON CH GOSUB 1000,1100,1200,1300,1400,1500,1600,1700
280 IF CH > 4 AND CH < 9 THEN WR = 1
290 IF CH <> 9 AND N < (NT - 20) AND E < (ET - 5) THEN 160
300 Z = 0:FOR I = 1 TO N
310 IF P(I) = -1 THEN Z = Z + 1
320 A$(I) = A$(I + Z):P(I) = P(I + Z):S(I) = S(I + Z):F(I) = F(I + Z)
330 NEXT I:N = N - Z:X = 1
340 IF X > E THEN 410
350 Y = 0:FOR Z = 1 TO N:IF P(Z) = X THEN Y = 1
360 NEXT Z:IF Y = 1 THEN 400
370 FOR Y = X TO E:L$(Y) = L$(Y + 1):T(Y) = T(Y + 1):NEXT Y:E = E - 1
380 FOR Z = 1 TO N:IF P(Z) >X THEN P(Z) = P(Z) - 1
390 NEXT Z
400 X = X + 1:GOTO 340
410 IF CH <> 9 THEN 160
420 IF WR = 0 THEN PRINT "(No changes)":END
430 PRINT "Saving new data...":OPEN "O",1,"A:"+QU$+".NAG"
440 WRITE #1,N,E:FOR I = 1 TO N
450 WRITE #1,A$(I),S(I),F(I),P(I)
460 NEXT I:FOR I = 1 TO E
470 WRITE #1,L$(I),T(I):NEXT I:CLOSE #1:END
1000 PRINT "Enter the date you would like to look at ";:GOSUB 2700: IF U = 0 THEN RETURN
1010 FD = 0:BL = 0:T = U:FOR X = 0 TO 4:Y = 0:FOR I = 1 TO N:IF F(I) <> (T + X) OR S(I) > U OR P(I) = -1 THEN 1040
1020 IF Y = 0 THEN Y = 1:PRINT:PRINT G$(X + 1)
1030 GOSUB 2400:PRINT A$(I),S$,F$,L$(P(I))
1040 NEXT I:NEXT X:PRINT:BL = 0
1050 FOR I = 1 TO N:IF S(I) > T OR F(I) < (T + 5) OR P(I) = -1 THEN 1080
1060 IF FD = 1 AND BL = 0 THEN PRINT G$(6)
1070 GOSUB 2400:PRINT A$(I),S$,F$,L$(P(I))
1080 NEXT I:PRINT:IF FD = 0 THEN PRINT " (No activities found)":GOSUB 2800:RETURN
1090 PRINT " (That's all)":GOSUB 2800:RETURN
1100 PRINT "EVENT",,"Date":PRINT "-----",,"----"
1110 FOR I = 1 TO E:U = T(I):GOSUB 2500
1120 PRINT L$(I),,U$
1130 IF I / 20 = INT(I / 20) THEN GOSUB 2800
1140 NEXT I:PRINT:PRINT " (That's all)":GOSUB 2800:RETURN
1200 GOSUB 2100:IF L = 0 THEN RETURN
1210 U = T(L):GOSUB 2500
1220 PRINT " ---<< ";L$(L);" >--< ";U$;" >>---"
1230 PRINT:PRINT "Activity","Start date","End date"
1240 PRINT "--------","----------","--------":FD = 0
1250 FOR I = 1 TO N:IF P(I) <> L THEN 1280
1260 GOSUB 2400:PRINT A$(I)," ";S$,F$
1270 IF I/20 = INT(I/20) THEN GOSUB 2800
1280 NEXT I:IF FD = 0 THEN PRINT "No activities found."
1290 GOSUB 2800:RETURN
1300 FOR I=1 TO N:IF I = 1 THEN 1330
1310 IF I/14 > INT(I/14) THEN 1350
1320 GOSUB 2800
1330 CLS:PRINT "Activity","Start date","End date","Event"
1340 PRINT "--------","----------","--------","-----"
1350 IF P(I) = -1 THEN 1380
1360 GOSUB 2400
1370 PRINT A$(I)," ";S$,F$,L$(P(I))
1380 NEXT I:PRINT:PRINT " (That's all)":GOSUB 2800:RETURN
1400 IF E < ET - 2 THEN 1430
1410 PRINT "If you wish to add another event please quit the program and run it again."
1420 GOSUB 2800:RETURN
1430 L$ = "":INPUT "Enter name of event";L$:IF L$ = "" THEN RETURN
1440 L = 0:FOR I = 1 TO E:IF L$(I) = L$ THEN L = 1
1450 NEXT I:IF L = 1 THEN PRINT "There is already an event by that name.":GOTO 1400
1460 PRINT "Enter date of ";L$;" ";:GOSUB 2700
1470 E = E + 1:L$(E) = L$:T(E) = U:L = E
1480 GOSUB 1900:RETURN
1500 GOSUB 2100:IF L=0 THEN RETURN
1510 GOSUB 1900:RETURN
1600 GOSUB 2100:IF L=0 THEN RETURN
1610 PRINT "Are you sure you want to delete ";L$;" (N/Y)";:INPUT I$
1620 IF I$ <> "Y" THEN RETURN
1630 FOR I = L TO E
1640 L$(I) = L$(I+1):T(I) = T(I+1)
1650 NEXT I:E = E-1
1660 FOR I = 1 TO N
1670 IF P(I) = L THEN P(I) = -1
1680 IF P(I) > L THEN P(I) = P(I) - 1
1690 NEXT I:RETURN
1700 INPUT "Name of activity";A$:W = 0:FOR I = 1 TO N:IF A$(I) <> A$ OR P(I) = -1 THEN 1730
1710 W = W + 1:J = I:GOSUB 2400
1720 PRINT W;" - ";A$(I),S$,F$,L$(P(I))
1730 NEXT I
1740 IF W = 0 THEN PRINT "No activity ";CHR$(34);A$;CHR$(34);" is recorded":GOSUB 2800:RETURN
1750 IF W = 1 THEN I = J:GOTO 1810
1760 INPUT "Which of the above";J:IF J < 1 OR J > W THEN 1760
1770 I = 0:FOR K = 1 TO J
1780 I = I + 1:IF A$(I) <> A$ THEN 1780
1790 NEXT K:PRINT:GOSUB 2400
1800 PRINT A$,S$,F$,L$(P(I))
1810 INPUT "Change or delete this (Y/N)";I$
1820 IF I$ = "N" THEN RETURN
1830 GOSUB 2200
1840 IF LT = -1 THEN P(I) = -1
1850 RETURN
1900 IF N > NT - 5 THEN PRINT "If you wish to add any more activities, please quit the program and run it again.":GOSUB 2800:RETURN
1910 N = N + 1:LT = L
1920 A$ = "":INPUT "Enter activity name";A$:IF A$ = "" THEN RETURN
1930 PRINT "Enter start date ";:GOSUB 2700:S = U:S$ = U$
1940 PRINT "Enter end date ";:GOSUB 2700:F = U:F$ = U$
1950 IF S > F THEN PRINT "Ending before started!":GOTO 1930
1960 A$(N) = LEFT$(A$,14):S(N) = S:F(N) = F:P(N) = LT:I = N
1970 IF P(I) = -1 THEN 2000
1980 PRINT:PRINT A$(N),S$,F$,L$(P(N))
1990 INPUT "Okay (Y/N)";I$:IF I$ = "N" THEN GOSUB 2200:GOTO 1950
2000 INPUT "Add another activity (Y/N)";I$:IF I$ = "N" THEN RETURN
2010 GOTO 1900
2100 INPUT "Name of event";L$:L = 0:FOR I = 1 TO E
2110 IF L$(I)=L$ THEN L = I
2120 NEXT I:IF L > 0 THEN 2140
2130 PRINT "There is no event ";CHR$(34);L$;CHR$(34):GOSUB 2800
2140 CLS:RETURN
2200 LT = L:INPUT "Delete it (N/Y)";I$
2210 IF I$ = "Y" THEN LT = -1:RETURN
2220 INPUT "New name (RETURN = old)";I$
2230 IF I$ <> "" THEN A$(I) = I$
2240 PRINT "New start date (RETURN = old) ";:GOSUB 2700
2250 IF U > 0 THEN S(I) = U:S = U
2260 PRINT "New end date (RETURN = old) ";:GOSUB 2700
2270 IF U > 0 THEN F(I) = U:F = U
2280 IF S > F THEN PRINT "Ending before started!":GOTO 2240
2290 IF CH <> 8 THEN RETURN
2300 INPUT "New event (RETURN = old)";I$
2310 L = 0:IF I$ = "" THEN RETURN
2320 FOR J = 1 TO E:IF L$(J) = I$ THEN L = J
2330 NEXT J:IF L = 0 THEN PRINT " No such event":GOTO 2300
2340 P(I) = L:RETURN
2400 U = S(I):GOSUB 2500:S$ = U$:FD = 1:BL = 1
2410 U = F(I):GOSUB 2500:F$ = U$:RETURN
2500 ME = 1:IF U < 366 THEN YR = 0:D = U:DA = U:GOTO 2540
2510 Y4 = INT((U-366)/1461) + 1:D4 = U + 1096 - 1461 * Y4
2520 YE = INT((D4 - 1)/365):IF YE = 4 THEN YE = 3
2530 YR = 4 * Y4 + YE - 3:D = D4 - 365 * YE
2540 IF D <= 31 THEN DA = D:ME = 1:GOTO 2590
2550 LP = INT(YR/4)*4 = YR AND YR <> 0
2560 IF D <= 59 - LP THEN DA = D - 31:ME = 2:GOTO 2590
2570 IF D <= M(ME+1) - LP THEN DA = D - M(ME) + LP:GOTO 2590
2580 ME = ME + 1:GOTO 2550
2590 U$ = RIGHT$(STR$(ME),2) + "/" + RIGHT$(STR$(DA),2) + "/" + RIGHT$(STR$(YR),2)
2600 FOR C = 1 TO 8:IF MID$(U$,C,1) = " " THEN MID$(U$,C,1) = "0"
2610 NEXT C:RETURN
2700 U = O:I$ = "":INPUT "(MM/DD/YY)";I$:IF I$ = "" THEN RETURN
2710 IF LEN(I$)<>8 OR MID$(I$,3,1)<>"/" OR MID$(I$,6,1)<>"/" THEN 2700
2720 ME = VAL(LEFT$(I$,2)):DA = VAL(MID$(I$,4,2)):YR = VAL(RIGHT$(I$,2))
2730 IF YR < 0 OR Y > 99 OR ME < 1 OR ME > 12 THEN 2700
2740 IF INT(YR/4) = YR/4 AND YR > 0 AND ME = 2 AND DA < 30 THEN 2760
2750 IF DA > M(ME + 1) - M(ME) THEN 2700 ELSE 2760
2760 LY = INT((YR-1)/4):IF LY < 0 THEN LY = 0
2770 M = M(ME):IF ME > 2 AND INT(YR/4) * 4 = YR AND YR <> 0 THEN M = M + 1
2780 U = YR * 365 + LY + M + DA:GOSUB 2500:RETURN
2800 PRINT:PRINT "Press any key to continue...";
2810 X$ = INKEY$ : IF X$ = "" THEN 2810
2820 PRINT:RETURN
2900 DATA Urgent! Today is the last day for...,Warning! Only one day left for...,Better hurry! Only two days left for...
2910 DATA Don't forget! Only three days left for...,Pay attention! Only four days left for...,Also remember...
2920 DATA 0,31,59,90,120,151,181,212,243,273,304,334,365